home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / ffccflow / ffccflow.lha / ffccc+flow / ffccc / ALLPRO.f < prev    next >
Encoding:
Text File  |  1992-07-31  |  2.4 KB  |  74 lines
  1.       SUBROUTINE ALLPRO 
  2. *-----------------------------------------------------------------------
  3. *   
  4. *--- Overall control of FLOP run.   
  5. *   
  6. *-----------------------------------------------------------------------
  7.       include 'PARAM.h' 
  8.       include 'ALCAZA.h' 
  9.       include 'JOBSUM.h' 
  10.       include 'FLAGS.h' 
  11.       include 'STATE.h' 
  12. *--- print header   
  13.       CALL HEADER   
  14. *--- initialize 
  15.       CALL FLINIT   
  16.       CALL STADEF   
  17. *--- read command lines 
  18.       CALL INDECO   
  19.       CALL INDECT   
  20. *--- user total initialization  
  21.       IF(ACTION(22))  CALL UTINIT   
  22. *--- start processing   
  23.    10 CONTINUE  
  24. *--- process if enough time left (only if CERN flag on) 
  25.       IF(.NOT.STATUS(4))  THEN  
  26. *--- read one complete routine  
  27.          CALL READEC
  28. *--- process if still something read
  29.          IF (.NOT.STATUS(2))  THEN  
  30. *--- count lines
  31.             DO 20 I=NFLINE(1),NLLINE(NSTAMM)
  32.                IF (NLTYPE(I).EQ.0) NSTATC(7)=NSTATC(7)+1
  33.                IF (NLTYPE(I).EQ.1) NSTATC(3)=NSTATC(3)+1
  34.    20       CONTINUE
  35.             NSTATC(1)=NSTATC(1)+NLLINE(NSTAMM)-NFLINE(1)+1  
  36. *--- set pointer and count for routine name list
  37.             NRNAME=0
  38.             IRNAME=IGNAME+NGNAME
  39. *--- process one complete routine   
  40.             CALL PROCES 
  41.             IF (NRNAME.GT.0)  THEN  
  42.                IF (ACTION(25))  THEN
  43. *--- print list of routine names
  44.                   WRITE (MPUNIT,10000) SCROUT,NRNAME
  45.                   IF (ACTION(20))  THEN 
  46. *--- print name list with types 
  47.                      CALL PRNAMF(IRNAME+1,IRNAME+NRNAME)
  48.                   ELSE  
  49.                      WRITE (MPUNIT,10010) (SNAMES(IRNAME+J),J=1,NRNAME) 
  50.                   ENDIF 
  51.                ENDIF
  52.                IF (ACTION(2))  THEN 
  53. *--- merge with global namelist 
  54.                   CALL LMERGE(SNAMES,NAMTYP,.TRUE.,IGNAME,NGNAME,NRNAME)
  55.                   CALL SUPMUL(SNAMES,NAMTYP,.TRUE.,IGNAME,NGNAME+NRNAME,
  56.      +            NGNAME)   
  57.                ENDIF
  58.             ENDIF   
  59.             IF(ACTION(27).AND..NOT.STATUS(12))  THEN
  60. *--- print common block information 
  61.                CALL PRTCOM  
  62.             ENDIF   
  63. *--- write output file  
  64.             CALL PUTOUT 
  65.             GOTO 10 
  66.          ENDIF  
  67.       ENDIF 
  68. *--- user total termination 
  69.       IF(ACTION(22))  CALL UTTERM   
  70.       CALL SUMMRY   
  71. 10000 FORMAT(//' Routine = ',A8,',  list of',I6,' names'/)  
  72. 10010 FORMAT(1X,10A10)  
  73.       END   
  74.